home *** CD-ROM | disk | FTP | other *** search
/ Especial Multimedia / Especial Multimedia.iso / Multimed / Herra / QVIEW.ZIP / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1997-09-14  |  4KB  |  163 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, FileCtrl, Placemnt,
  8.   About;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     StatusLine: TPanel;
  13.     DirectoryListBox1: TDirectoryListBox;
  14.     FileListBox1: TFileListBox;
  15.     DriveComboBox1: TDriveComboBox;
  16.     FilterComboBox1: TFilterComboBox;
  17.     GroupBox1: TGroupBox;
  18.     Panel1: TPanel;
  19.     Image1: TImage;
  20.     CBStretch: TCheckBox;
  21.     CBAutoSize: TCheckBox;
  22.      CBCenter: TCheckBox;
  23.      BCopyFile: TBitBtn;
  24.      SaveDialog1: TSaveDialog;
  25.     BitBtn1: TBitBtn;
  26.      BitBtn2: TBitBtn;
  27.      CBRatio: TCheckBox;
  28.      Placement1: TPlacement;
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure ShowHint(Sender: TObject);
  31.      procedure CBStretchClick(Sender: TObject);
  32.      procedure CBAutoSizeClick(Sender: TObject);
  33.      procedure CBCenterClick(Sender: TObject);
  34.      procedure BCopyFileClick(Sender: TObject);
  35.      procedure FileListBox1Change(Sender: TObject);
  36.      procedure BitBtn1Click(Sender: TObject);
  37.      procedure CBRatioClick(Sender: TObject);
  38.      procedure BitBtn2Click(Sender: TObject);
  39.      procedure FormDestroy(Sender: TObject);
  40.   end;
  41.  
  42. var
  43.   MainForm: TMainForm;
  44.  
  45. implementation
  46.  
  47. {$R *.DFM}
  48.  
  49. procedure TMainForm.FormCreate(Sender: TObject);
  50. begin
  51.   Application.OnHint := ShowHint;
  52.   Placement1.IniFileName := ChangeFileExt(Paramstr(0), '.INI');
  53.   Placement1.Read;
  54. end;
  55.  
  56. procedure TMainForm.ShowHint(Sender: TObject);
  57. begin
  58.   StatusLine.Caption := Application.Hint;
  59. end;
  60.  
  61. procedure TMainForm.CBStretchClick(Sender: TObject);
  62. begin
  63.     Image1.Stretch := CBStretch.Checked;
  64. end;
  65.  
  66. procedure TMainForm.CBAutoSizeClick(Sender: TObject);
  67. begin
  68.     Image1.AutoSize := CBAutoSize.Checked;
  69.     if not Image1.AutoSize then begin
  70.         Image1.Height := Panel1.Height-10;
  71.         Image1.Width := Panel1.Width-10;
  72.     end;
  73. end;
  74.  
  75. procedure TMainForm.CBCenterClick(Sender: TObject);
  76. begin
  77.     Image1.Center := CBCenter.Checked;
  78. end;
  79.  
  80. procedure TMainForm.BCopyFileClick(Sender: TObject);
  81. Const BufLength = 2000;
  82. Var   fS, fD          : File;
  83.         Buf             : ^Byte;
  84.         NumRead,
  85.         NumWritten      : Word;
  86.         Ext                : String;
  87. begin
  88.     Ext := UpperCase(ExtractFileExt(FileListBox1.FileName));
  89.     if Ext='.BMP' then
  90.         SaveDialog1.Filter := 'Bitmaps|*.BMP';
  91.     if Ext='.WMF' then
  92.         SaveDialog1.Filter := 'Windows Meta Files|*.WMF';
  93.     if Ext='.ICO' then
  94.         SaveDialog1.Filter := 'Icons|*.ICO';
  95.     if SaveDialog1.Execute then begin
  96.         FileMode := 0;
  97.         getmem(Buf, BufLength);
  98.         if Buf=NIL then
  99.             exit;
  100.         AssignFile(fS, FileListBox1.FileName);
  101.         Reset(fS, 1);
  102.         AssignFile(fD, SaveDialog1.FileName);
  103.         Rewrite(fD, 1);
  104.         repeat
  105.             BlockRead(fS, Buf^, BufLength-1, NumRead);
  106.             BlockWrite(fD, Buf^, NumRead, NumWritten);
  107.         until eof(fS) or (NumRead=0) or (NumWritten<>NumRead);
  108.         CloseFile(fD);
  109.         CloseFile(fS);
  110.     end;
  111.    FileListBox1.Refresh;
  112. end;
  113.  
  114. procedure TMainForm.FileListBox1Change(Sender: TObject);
  115. begin
  116.     if FileListBox1.ItemIndex>=0 then begin
  117.         try
  118.             Image1.Picture.LoadFromFile(FileListBox1.FileName);
  119.         except
  120.             MessageDlg('Error loading file!', mtError, [mbOK], 0);
  121.             Image1.Picture := NIL;
  122.         end;
  123.         if CBRatio.Checked then begin
  124.             if Image1.Picture.Height>=Image1.Picture.Width then begin
  125.                 Image1.Height := Panel1.Height-10;
  126.                 Image1.Width := Round(LONGINT(Image1.Picture.Height)*LONGINT(Image1.Height)/Image1.Picture.Width);
  127.             end
  128.             else    begin
  129.                         Image1.Width := Panel1.Width-10;
  130.                         Image1.Height := Round(LONGINT(Image1.Picture.Height)*LONGINT(Image1.Width)/Image1.Picture.Width);
  131.                     end;
  132.         end;
  133.     end;
  134. end;
  135.  
  136. procedure TMainForm.BitBtn1Click(Sender: TObject);
  137. begin
  138.     Close;
  139. end;
  140.  
  141. procedure TMainForm.CBRatioClick(Sender: TObject);
  142. begin
  143.     if not CBRatio.Checked then begin
  144.         Image1.Height := Panel1.Height-10;
  145.         Image1.Width := Panel1.Width-10;
  146.     end;
  147.     FileListBox1Change(self);
  148. end;
  149.  
  150. procedure TMainForm.BitBtn2Click(Sender: TObject);
  151. begin
  152.     Application.CreateForm(TAboutBox, AboutBox);
  153.     AboutBox.ShowModal;
  154.    AboutBox.Free;
  155. end;
  156.  
  157. procedure TMainForm.FormDestroy(Sender: TObject);
  158. begin
  159.     Placement1.Write;
  160. end;
  161.  
  162. end.
  163.